perm filename DISPLY.SAI[PNT,HE]3 blob
sn#343392 filedate 1978-03-23 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00005 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 ENTRY
C00004 00003 ! basic display procedures
C00007 00004 ! display: inidpy,dpydraw,dpyfree,outfr,outsc,outdf,outtr,outfl,outrt,outvt,outtty
C00013 00005 ! display: tree_string,dpy_string
C00018 ENDMK
C⊗;
ENTRY;
BEGIN "DISPLY"
REQUIRE "MACROS.SAI[PNT,HE]"SOURCE_FILE;
REQUIRE "DDLIB.HDR[PNT,HE]" SOURCE_FILE; ! calls DDLIB[SUB,SYS];
REQUIRE "III2DD.HDR[PNT,HE]" SOURCE_FILE; ! calls III2DD[sub,sys];
REQUIRE "DPYSYS.HDR[PNT,HE]" SOURCE_FILE; ! calls DISPLY[SUB,SYS];
REQUIRE "RECORD.DEF[PNT,HE]" SOURCE_FILE;
DEFINE #MAXDPT = 10; ! #MAXDPT of frame tree for display;
INTERNAL INTEGER $NCHAR; ! # of characters for frame tree;
EXTERNAL INTEGER $DPYTAB; ! break table used to skip blanks;
EXTERNAL INTEGER $ARROW; ! vertical position of the arrow;
EXTERNAL STRING $BLANK;
EXTERNAL STRING $TRLST,$FRLST,$SCLST,$VTLST,$RTLST,$OULST,$DFLST;
EXTERNAL STRING $TTYFL;
! in OUTPUT.SAI;
EXTERNAL SIMPLE STRING PROCEDURE CVGX(REAL R);
EXTERNAL SIMPLE STRING PROCEDURE STR_RT(REAL ARRAY XF;INTEGER NUM(1));
EXTERNAL SIMPLE STRING PROCEDURE STR_VT(REAL X,Y,Z;INTEGER NUM(1));
EXTERNAL SIMPLE STRING PROCEDURE STR_TR(REAL ARRAY XF;INTEGER ROT(1),VECT(1));
! basic display procedures;
INTEGER ARRAY ∂BUF[1:1000];
INTEGER ∂CHWID; ! width of a character;
INTEGER ∂CHIGH; ! height of a line;
INTEGER ∂SIZE; ! size of the characters;
INTERNAL INTEGER ∂DLMAR;
INTEGER ∂DRMAR,∂DTMAR,∂DBMAR; ! whole display area;
INTEGER ∂TPMAR; ! typing space top margin;
INTEGER ∂SCFR; ! margin between frames and scalars;
INTEGER ∂FLRT; ! margin between files and rot's;
INTEGER ∂RTVT; ! margin between rot's and vectors;
INTEGER ∂SCDF; ! margin between defaults and scalars;
INTEGER ∂TRFL; ! trans's bottom margin;
INTEGER ∂UPLNS,∂DWNLNS; ! # of lines for frame tree and arithmetic;
INTEGER ∂WFR; ! width of space for frame tree;
INTEGER ∂WSC; ! width of space for scalars;
INTEGER ∂WRTVT; ! width of space for vectors,rot's;
INTEGER ARRAY PPINFTBL[0:23];
DEFINE PPIOT "[]" = ['702000000000];
DEFINE PPINFO "[]" = [PPIOT 5,];
BOOLEAN PROCEDURE ONDD;
START_CODE
PPINFO PPINFTBL[0];
MOVE 1,PPINFTBL[2];
TLNN 1,'100000;
TDZA 1,1;
SETO 1,;
END;
INTERNAL SIMPLE PROCEDURE DRAWLINE(INTEGER X0,Y0,X1,Y1);
BEGIN
AIVECT(X1,Y1);
AVECT(X0,Y0);
END;
SIMPLE PROCEDURE DRAWBOX(INTEGER X0,Y0,X1,Y1);
BEGIN
AIVECT(X0,Y0);
AVECT(X0,Y1);
AVECT(X1,Y1);
AVECT(X1,Y0);
AVECT(X0,Y0);
END;
PROCEDURE OUTBLK(STRING STR;INTEGER X,Y,WID,NLINES,SIZE);
BEGIN
INTEGER BRK,NCHAR;STRING S,T;LABEL L;
NCHAR←WID/∂CHWID;
WHILE STR DO
BEGIN
S←SCAN(STR,$DPYTAB,BRK);
IF BRK≠CR THEN DONE;
WHILE S DO
BEGIN
IF LENGTH(S)>NCHAR
THEN BEGIN
T←S[1 FOR NCHAR];S←S[NCHAR+1 FOR ∞];
END
ELSE BEGIN
T←S;S←NULL;
END;
AIVECT(X,Y);
DPYSST(T);
Y←Y-SIZE;
IF (NLINES←NLINES-1)≤0 THEN GO TO L;
END;
END;
L: END;
! display: inidpy,dpydraw,dpyfree,outfr,outsc,outdf,outtr,outfl,outrt,outvt,outtty;
INTERNAL SIMPLE PROCEDURE INIDPY;
BEGIN
∂CHIGH←20;
∂SIZE←2;
IF ONDD THEN
BEGIN
∂DLMAR←-625;
∂DRMAR←580;
∂DTMAR←450;
∂DBMAR←-510;
∂CHWID←15;
END
ELSE
BEGIN
∂DLMAR←-510;
∂DRMAR←510;
∂DTMAR←450;
∂DBMAR←-450; ! PROVA;
∂CHWID←12;
END;
∂TPMAR←∂DBMAR+(∂DTMAR-∂DBMAR)*0.20;
∂TRFL←-70; ! horizontal lines;
∂SCDF←-10;
∂SCFR←∂DRMAR-180; ! vertical lines;
∂FLRT←∂DLMAR+295;
∂RTVT←(∂DRMAR-∂FLRT)/2 + ∂FLRT;
∂WFR←∂SCFR-∂DLMAR-10; ! width;
∂WSC←∂DRMAR-∂SCFR-10;
∂WRTVT← ∂RTVT-∂FLRT - 10;
$NCHAR←∂WFR/∂CHWID;
∂UPLNS←(∂DTMAR-∂TRFL)/∂CHIGH; ! number of lines;
∂DWNLNS←(∂TRFL-∂TPMAR)/∂CHIGH;
$ARROW←15; ! initialization of arrow;
END;
IFC FALSE THENC
! draws an arrow drawing lines between the 7 points (1 to 7). The dimensions
of the arrow and the names of the variables used are
. 80 . 20 .
c3y ..................3.....................
. |\ . 10
c12y 1 ________________2| \ .................
| . \ .
c4y | . \4 20
| . /.
|__________________ /................
c67y 7. 6| / . 10
c5y ..................|/....................
. 5 .
. . .
c17x c2356x c4x ;
SIMPLE PROCEDURE ARROW;
BEGIN ! $ARROW is the arrow position;
INTEGER C17X,C2356X,C4X,C12Y,C3Y,C5Y,C67Y,I;
C17X←∂DLMAR-25;
C2356X←C17X+80;
C4X←C2356X+20;
C3Y←$ARROW-20;
C5Y←$ARROW+20;
C12Y←$ARROW-10;
C67Y←$ARROW+10;
DRAWLINE(C17X,C12Y,C2356X,C12Y);
DRAWLINE(C2356X,C12Y,C2356X,C3Y);
DRAWLINE(C2356X,C3Y,C4X,$ARROW);
DRAWLINE(C4X,$ARROW,C2356X,C5Y);
DRAWLINE(C2356X,C5Y,C2356X,C67Y);
DRAWLINE(C17X,C67Y,C2356X,C67Y);
DRAWLINE(C17X,C12Y,C17X,C67Y);
FOR I←C17X STEP 2 UNTIL C2356X DO
DRAWLINE(I,C12Y,I,C67Y);
FOR I←C2356X STEP 2 UNTIL C4X DO
DRAWLINE(I,C3Y+(I-C2356X),I,C5Y-(I-C2356X));
END;
ELSEC EXTERNAL SIMPLE PROCEDURE ARROW;
ENDC
INTERNAL SIMPLE PROCEDURE DPYDRAW;
BEGIN
DPYSET(∂BUF);
DPYBIG(∂SIZE);
TYPLOC(∂TPMAR-∂CHIGH,∂DBMAR);
DRAWBOX (∂DLMAR,∂DTMAR,∂DRMAR,∂TPMAR);
DRAWLINE(∂SCFR,∂DTMAR,∂SCFR,∂TRFL);
DRAWLINE(∂SCFR,∂SCDF,∂DRMAR,∂SCDF);
DRAWLINE(∂DLMAR,∂TRFL,∂DRMAR,∂TRFL);
DRAWLINE(∂FLRT,∂TRFL,∂FLRT,∂TPMAR);
DRAWLINE(∂RTVT,∂TRFL,∂RTVT,∂TPMAR);
ARROW;
END;
INTERNAL SIMPLE PROCEDURE DPYFREE;
BEGIN
DPYCLR;DPYSET(∂BUF);
TYPLOC(∂DTMAR-∂CHIGH,∂TPMAR);DPYOUT(1); ! turns off the display;
END;
INTERNAL SIMPLE PROCEDURE OUTDPY;
BEGIN
OUTBLK($FRLST,
∂DLMAR+5,∂DTMAR-∂CHIGH-5,
∂WFR,∂UPLNS-6,∂CHIGH);
OUTBLK($SCLST,
∂SCFR+5,∂DTMAR-∂CHIGH-5,
∂WSC,∂UPLNS-4,∂CHIGH);
OUTBLK($DFLST,
∂SCFR+5,∂SCDF-∂CHIGH-5,
∂WSC,3,∂CHIGH);
OUTBLK($TRLST,
∂DLMAR+5,∂SCDF-2*∂CHIGH-5,
∂WFR,6,-∂CHIGH);
OUTBLK($VTLST,
∂RTVT+5,∂TRFL-∂CHIGH-5,
∂WRTVT,∂DWNLNS,∂CHIGH);
OUTBLK($RTLST,
∂FLRT+5,∂TRFL-∂CHIGH-5,
∂WRTVT,∂DWNLNS,∂CHIGH);
OUTBLK($OULST,
∂DLMAR+5,∂TRFL-∂CHIGH-5,
∂FLRT-∂DLMAR-10,∂DWNLNS-2,∂CHIGH);
OUTBLK($TTYFL&CRLF,
∂DLMAR+5,∂TPMAR + ∂CHIGH+5,
∂WRTVT,1,∂CHIGH);
END;
! display: tree_string,dpy_string;
! returns a string with the frame tree (names , trans part and affixment
type for frames);
INTERNAL RECURSIVE STRING PROCEDURE FRTREE(RPTR(FRAME) ND;INTEGER DEPTH);
BEGIN
STRING TS;INTEGER L;
DEPTH←DEPTH+1;
IF DEPTH>#MAXDPT THEN RETURN(NULL);
TS←NULL;
! L←DEPTH*2-1; ! without arrow;
L←DEPTH*2+3;
TS←TS&$BLANK[1 FOR L]&"-+*"[1+FRAME:HOWLINKED[ND] FOR 1]&FRAME:PNAME[ND]
&STR_TR(FRAME:XF[ND],4,8);
IF LENGTH (TS)>$NCHAR
THEN TS←TS[1 TO $NCHAR-1]&CRLF&$BLANK[1 TO DEPTH*2-1]
&TS[$NCHAR TO ∞]&CRLF
ELSE TS←TS&CRLF;
ND←FRAME:SON[ND];
WHILE ND≠NULL_RECORD DO
BEGIN
! BPARK/YPARK not displayed;
IF ND≠F_BPARK AND ND≠F_YPARK
THEN TS←TS&FRTREE(ND,DEPTH);
ND←FRAME:EBRO[ND];
END;
RETURN(TS);
END;
INTERNAL STRING PROCEDURE TREE_STRING;
BEGIN
STRING TS;RPTR(FRAME)ND;
TS←"STATION (NILROTN,NILVECT)"&CRLF;
ND←FRAME:SON[F_WRLD];
WHILE ND≠NULL_RECORD DO
BEGIN
! BPARK/YPARK not displayed;
IF ND≠F_BPARK AND ND≠F_YPARK
THEN TS←TS&FRTREE(ND,0);
ND←FRAME:EBRO[ND];
END;
RETURN(TS);
END;
! returns a string with name and value of the variables of the
indicated type;
INTERNAL STRING PROCEDURE DPY_STRING(INTEGER TYPE);
BEGIN
INTEGER ADDRIN,ADDRFN,I;
RPTR(SYMBOL)ADDR;STRING TS;
ADDRIN←#LTYPE*(TYPE-#MIN); ! initial address in $YMTAB;
ADDRFN←$ENTRY[TYPE]-1; ! final address;
TS←NULL;
FOR I←ADDRIN STEP 1 UNTIL ADDRFN DO
BEGIN
ADDR←$YMTAB[I]; ! if null_record is a deleted symb;
IF ADDR≠NULL_RECORD
THEN CASE TYPE OF
BEGIN "case"
[#SC]
IF ADDR≠INCHES AND ADDR≠DEG AND ADDR≠INCH AND ADDR≠DEGREE
AND ADDR≠DEGRES THEN
TS←TS&" "&SYMBOL:PNAME[ADDR]&" "
&CVGX(SCALAR:VALUE[SYMBOL:OBJECT[ADDR]])&CRLF;
[#VT] BEGIN
RPTR(VECTOR)IND;
IND←SYMBOL:OBJECT[ADDR];
IF ADDR=NILVECT
THEN TS←TS&" NILVECT (.000,.000,.000)"&CRLF
ELSE
IF ADDR≠XHAT AND ADDR≠YHAT AND ADDR≠ZHAT
THEN TS←TS&" "&SYMBOL:PNAME[ADDR]&" "
&STR_VT(VECTOR:XC[IND],VECTOR:YC[IND],
VECTOR:ZC[IND],8)&CRLF;
END;
[#RT] BEGIN
RPTR(ROT) IND;
IND←SYMBOL:OBJECT[ADDR];
IF ADDR=NILROTN
THEN TS←TS&" NILROTN (Z,.000) "&CRLF
ELSE TS←TS&" "&SYMBOL:PNAME[ADDR]&" ("
&STR_RT(ROT:XF[SYMBOL:OBJECT[ADDR]],4)&
")"&CRLF;
END;
[#TR] BEGIN
IF ADDRIN<ADDRFN AND I = ADDRIN
THEN TS←TS
ELSE TS←TS&" "&SYMBOL:PNAME[ADDR]
&STR_TR(TRANS:XF[SYMBOL:OBJECT[ADDR]],4,8)&CRLF
END
END "case";
END;
RETURN (TS);
END;
END "DISPLY";